Shareware Grab Bag/Shareware Grab Bag.iso/007/turboinc.arc/MACHDEP.INC

Text File | 1985-09-25 | 6.1 KB | 273 lines

const
  iodata    = 4;    {Z80 SIO port addresses for Kaypros}
  iocontrol = 6;    {Your machine may differ significantly}
  iorate    = 0;    {in addresses and serial port hardware.}

procedure lineout(message: line); forward;
 {lineout is in IO.INC - don't change this declaration!}

procedure clearstatus;

{Resets latching status flags on SIO chip -
 replace with empty procedure if not needed}

  begin
    port[iocontrol] :=16;
  end;

function outready: boolean;

{Returns true if serial output port is
 ready to transmit a new character}

  begin
    clearstatus;
    outready := (port[iocontrol] and 4) > 0;
  end;

procedure xmitchar(ch: char);

{Transmits ch when serial output port is ready,
   unless we're in the local mode.}

  begin
    if not local then begin
      repeat until outready;
      port[iodata] := ord(ch);
    end;
  end;

function cts: boolean;

{This function returns true if a carrier tone is present on the modem
 and is frequently checked to see if the caller is still present.
 It always returns "true" in the local mode.}

  begin
    clearstatus;
    cts := ((port[iocontrol] and 32) = 32) or local;
  end;

function inready: boolean;

{Returns true if we've got a character received
 from the serial port or keyboard.}

  begin
    inready := keypressed or ((port[iocontrol] and 1) > 0);
  end;

function recvchar: char;

{Returns character from serial input port,
  REGARDLESS of the status of inready.}

  begin
    recvchar := chr(port[iodata]);
  end;

procedure setbaud(speed: rate);

{For changing the hardware baud rate setting}

  begin
    case speed of
      slow: port[iorate] := 5;     { 300 baud}
      fast: port[iorate] := 7;     {1200 baud}
    end;
    baud := speed;
  end;

procedure clearSIO;

{ Initializes serial I/O chip - a Z80 SIO in this case:
  sets up for 8 bits, no parity and one stop bit on both
  transmit and receive, and allows character transmission
  with CTS low. Also sets RTS line high. }

  begin
    port[iocontrol] := $18;
    port[iocontrol] := 4;
    port[iocontrol] := $44;
    port[iocontrol] := 3;
    port[iocontrol] := $C1;
    port[iocontrol] := 5;
    port[iocontrol] := $EA;
  end;

procedure clearmodem;        (* Modem Dependent *)

{Sets modem for auto-answer, CTS line as carrier detect, no command echo}

  var buffer: line;
      loop  : byte;
      ch    : char;

  begin
    buffer := cr + cr + '<O3N4N5N0Q>';
    for loop := 1 to length(buffer) do begin
      ch := buffer[loop];
      xmitchar(ch);
    end;
    writeln;
    write('Delaying...');
    delay(5000); {Delays while modem digests initialization codes}
    writeln;
  end;

procedure setup;

{Hardware initializion for system to start BBS program}

  begin
    port[8] := 12; { Sets Kaypro 2-84 Serial Printer port to 4800 baud }
    write(esc + 'B7'); { Protects 25th line of Kaypro 2-84 display }
    setbaud(fast);
    clearSIO;
    clearmodem;
  end;

function badframe: boolean;

{Indicates Framing Error on serial I/O chip - return false if not available.}

  begin
    port[iocontrol] := 1;
    badframe := (port[iocontrol] and 64) = 64;
  end;

procedure dropRTS;

{ Lowers RS-232 RTS line - used to inhibit auto-answer
   and to cause modem to hang up }

  begin
    port[iocontrol] := 5;
    port[iocontrol] := $68;
  end;

procedure raiseRTS;

(* Raises RTS line to enable auto-answer *)

  begin
    port[iocontrol] := 5;
    port[iocontrol] := $EA;
  end;

procedure setlocal;

{Sets local flag true and inhibits modem auto-answer}

  begin
    dropRTS; {Inhibits Rixon auto-answer}
    local := true;
  end;

procedure clearlocal;

{Clears local flag and allows modem auto-answer}

  begin
    raiseRTS; {Enables Rixon Auto-answer}
    local := false;
  end;

procedure unload;

{Halts Kaypro disk drives - normally they run for about 15 secs.}

  begin
    port[20] := (port[20] and $EF);
  end;

procedure dispcaller;

{Displays caller's name on protected 25th line of host CRT;
 Replace with empty procedure if not desired.}

  begin
    write(esc + 'B6' + esc + '=' + chr(56) + ' ');
    write(caller);
    if clockin then write(' called at ' + timeon);
    write(#24 + esc + 'C6');    {#24 = clear to end of line}
  end;

procedure hangup;

{Signals modem to hang up - in this case by lowering RTS line for 500 msec.}

  begin
    if cts then lineout('--- Disconnected ---' + cr + lf);
    dropRTS;
    delay(500);
    raiseRTS;
    if local then clearlocal else repeat until not cts;
  end;

{Real-time clock support begins here - this routine is called
 even if there is NO clock, so leave it and set clockin accordingly}

const
  rtca    = $20;  {Kaypro 4/84 and (modified) Kaypro 2/84 }
  rtcs    = $22;  {real-time clock control registers: will}
  rtcd    = $24;  {differ significantly on other hardware.}

procedure clock(var month,date,hour,min,sec: byte);

{Returns with month in range 1(Jan)..12(Dec),
 date in 1..length of month, hour in 0..23 (24-hr clock),
 minute and second in 0..59}

  var
    temp: byte;

  function bcd_to_dec(bcd: byte): byte;

  {Converts 2-digit/byte BCD to decimal}

    begin
      bcd_to_dec := (bcd and 15) + 10 * (bcd div 16);
    end;

  function inport(loc: byte): byte;

  {Reads Kaypro clock port data from register loc}

    begin
      port[rtca] := loc;
      inport := bcd_to_dec(port[rtcd]);
    end;

  procedure setupclock;

  {Sets Kaypro internal I/O port to address clock}

    var
      junk: byte;

    begin
      port[rtcs] := $CF;
      port[rtcs] := $E0;
      port[rtcs] := $03;
      junk := inport($14);
    end;

  begin
    if clockin then begin
      setupclock;
      repeat
        sec   := inport(2);
        min   := inport(3);
        hour  := inport(4);
        date  := inport(6);
        month := inport(7);
        temp  := inport(2);
      until temp = sec; {Make sure clock hasn't changed during reading}
    end;
  end;
t(7);
        temp  := inport(2);
      until temp = sec; {Make sure clock hasn't changed during reading}
    end;